home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT08NEW.ZIP / TUT8.PAS < prev    next >
Pascal/Delphi Source File  |  1995-01-14  |  15KB  |  448 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (* TUT8.PAS - VGA Trainer Program 8 (in Pascal)                              *)
  4. (*                                                                           *)
  5. (* "The VGA Trainer Program" is written by Denthor of Asphyxia.  However it  *)
  6. (* was limited to Pascal only in its first run.  All I have done is taken    *)
  7. (* his original release, translated it to C++, and touched up a few things.  *)
  8. (* I take absolutely no credit for the concepts presented in this code, and  *)
  9. (* am NOT the person to ask for help if you are having trouble.  -Snowman    *)
  10. (*                                                                           *)
  11. (* Program Notes : This program presents the basis of 3D.                    *)
  12. (*                                                                           *)
  13. (* Author        : Grant Smith (Denthor)  - denthor@beastie.cs.und.ac.za     *)
  14. (*                                                                           *)
  15. (*****************************************************************************)
  16.  
  17. {$X+}
  18. USES Crt;
  19.  
  20. CONST VGA = $A000;
  21.       MaxLines = 12;
  22.       Obj : Array [1..MaxLines,1..2,1..3] of integer =
  23.         (
  24.         ((-10,-10,-10),(10,-10,-10)),((-10,-10,-10),(-10,10,-10)),
  25.         ((-10,10,-10),(10,10,-10)),((10,-10,-10),(10,10,-10)),
  26.         ((-10,-10,10),(10,-10,10)),((-10,-10,10),(-10,10,10)),
  27.         ((-10,10,10),(10,10,10)),((10,-10,10),(10,10,10)),
  28.         ((-10,-10,10),(-10,-10,-10)),((-10,10,10),(-10,10,-10)),
  29.         ((10,10,10),(10,10,-10)),((10,-10,10),(10,-10,-10))
  30.         );  { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
  31.             { (X2,Y2,Z2) ... for the two ends of a line }
  32.  
  33.  
  34. Type Point = Record
  35.                x,y,z:real;                { The data on every point we rotate}
  36.              END;
  37.      Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  38.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  39.  
  40.  
  41. VAR Lines : Array [1..MaxLines,1..2] of Point;  { The base object rotated }
  42.     Translated : Array [1..MaxLines,1..2] of Point; { The rotated object }
  43.     Xoff,Yoff,Zoff:Integer;               { Used for movement of the object }
  44.     lookup : Array [0..360,1..2] of real; { Our sin and cos lookup table }
  45.     Virscr : VirtPtr;                     { Our first Virtual screen }
  46.     Vaddr  : word;                        { The segment of our virtual screen}
  47.  
  48.  
  49. {──────────────────────────────────────────────────────────────────────────}
  50. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  51. BEGIN
  52.   asm
  53.      mov        ax,0013h
  54.      int        10h
  55.   end;
  56. END;
  57.  
  58.  
  59. {──────────────────────────────────────────────────────────────────────────}
  60. Procedure SetText;  { This procedure returns you to text mode.  }
  61. BEGIN
  62.   asm
  63.      mov        ax,0003h
  64.      int        10h
  65.   end;
  66. END;
  67.  
  68. {──────────────────────────────────────────────────────────────────────────}
  69. Procedure Cls (Where:word;Col : Byte);
  70.    { This clears the screen to the specified color }
  71. BEGIN
  72.      asm
  73.         push    es
  74.         mov     cx, 32000;
  75.         mov     es,[where]
  76.         xor     di,di
  77.         mov     al,[col]
  78.         mov     ah,al
  79.         rep     stosw
  80.         pop     es
  81.      End;
  82. END;
  83.  
  84. {──────────────────────────────────────────────────────────────────────────}
  85. Procedure SetUpVirtual;
  86.    { This sets up the memory needed for the virtual screen }
  87. BEGIN
  88.   GetMem (VirScr,64000);
  89.   vaddr := seg (virscr^);
  90. END;
  91.  
  92.  
  93. {──────────────────────────────────────────────────────────────────────────}
  94. Procedure ShutDown;
  95.    { This frees the memory used by the virtual screen }
  96. BEGIN
  97.   FreeMem (VirScr,64000);
  98. END;
  99.  
  100.  
  101. {──────────────────────────────────────────────────────────────────────────}
  102. procedure flip(source,dest:Word);
  103.   { This copies the entire screen at "source" to destination }
  104. begin
  105.   asm
  106.     push    ds
  107.     mov     ax, [Dest]
  108.     mov     es, ax
  109.     mov     ax, [Source]
  110.     mov     ds, ax
  111.     xor     si, si
  112.     xor     di, di
  113.     mov     cx, 32000
  114.     rep     movsw
  115.     pop     ds
  116.   end;
  117. end;
  118.  
  119.  
  120. {──────────────────────────────────────────────────────────────────────────}
  121. Procedure Pal(Col,R,G,B : Byte);
  122.   { This sets the Red, Green and Blue values of a certain color }
  123. Begin
  124.    asm
  125.       mov    dx,3c8h
  126.       mov    al,[col]
  127.       out    dx,al
  128.       inc    dx
  129.       mov    al,[r]
  130.       out    dx,al
  131.       mov    al,[g]
  132.       out    dx,al
  133.       mov    al,[b]
  134.       out    dx,al
  135.    end;
  136. End;
  137.  
  138.  
  139. {──────────────────────────────────────────────────────────────────────────}
  140. Function rad (theta : real) : real;
  141.   {  This calculates the degrees of an angle }
  142. BEGIN
  143.   rad := theta * pi / 180
  144. END;
  145.  
  146.  
  147. {──────────────────────────────────────────────────────────────────────────}
  148. Procedure SetUpPoints;
  149.   { This sets the basic offsets of the object, creates the lookup table and
  150.     moves the object from a constant to a variable }
  151. VAR loop1:integer;
  152. BEGIN
  153.   Xoff:=160;
  154.   Yoff:=100;
  155.   Zoff:=-256;
  156.   For loop1:=0 to 360 do BEGIN
  157.     lookup [loop1,1]:=sin (rad (loop1));
  158.     lookup [loop1,2]:=cos (rad (loop1));
  159.   END;
  160.   For loop1:=1 to MaxLines do BEGIN
  161.     Lines [loop1,1].x:=Obj [loop1,1,1];
  162.     Lines [loop1,1].y:=Obj [loop1,1,2];
  163.     Lines [loop1,1].z:=Obj [loop1,1,3];
  164.     Lines [loop1,2].x:=Obj [loop1,2,1];
  165.     Lines [loop1,2].y:=Obj [loop1,2,2];
  166.     Lines [loop1,2].z:=Obj [loop1,2,3];
  167.   END;
  168. END;
  169.  
  170.  
  171. {──────────────────────────────────────────────────────────────────────────}
  172. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  173.   { This puts a pixel on the screen by writing directly to memory. }
  174. BEGIN
  175.   Asm
  176.     mov     ax,[where]
  177.     mov     es,ax
  178.     mov     bx,[X]
  179.     mov     dx,[Y]
  180.     mov     di,bx
  181.     mov     bx, dx                  {; bx = dx}
  182.     shl     dx, 8
  183.     shl     bx, 6
  184.     add     dx, bx                  {; dx = dx + bx (ie y*320)}
  185.     add     di, dx                  {; finalise location}
  186.     mov     al, [Col]
  187.     stosb
  188.   End;
  189. END;
  190.  
  191.  
  192.  
  193. {──────────────────────────────────────────────────────────────────────────}
  194. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  195.   { This draws a solid line from a,b to c,d in colour col }
  196.   function sgn(a:real):integer;
  197.   begin
  198.        if a>0 then sgn:=+1;
  199.        if a<0 then sgn:=-1;
  200.        if a=0 then sgn:=0;
  201.   end;
  202. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  203. begin
  204.      u:= c - a;
  205.      v:= d - b;
  206.      d1x:= SGN(u);
  207.      d1y:= SGN(v);
  208.      d2x:= SGN(u);
  209.      d2y:= 0;
  210.      m:= ABS(u);
  211.      n := ABS(v);
  212.      IF NOT (M>N) then
  213.      BEGIN
  214.           d2x := 0 ;
  215.           d2y := SGN(v);
  216.           m := ABS(v);
  217.           n := ABS(u);
  218.      END;
  219.      s := m shr 1;
  220.      FOR i := 0 TO m DO
  221.      BEGIN
  222.           putpixel(a,b,col,where);
  223.           s := s + n;
  224.           IF not (s<m) THEN
  225.           BEGIN
  226.                s := s - m;
  227.                a:= a + d1x;
  228.                b := b + d1y;
  229.           END
  230.           ELSE
  231.           BEGIN
  232.                a := a + d2x;
  233.                b := b + d2y;
  234.           END;
  235.      end;
  236. END;
  237.  
  238.  
  239. {──────────────────────────────────────────────────────────────────────────}
  240. Procedure DrawLogo;
  241.   { This draws 'ASPHYXIA' at the top of the screen in little balls }
  242. CONST ball : Array [1..5,1..5] of byte =
  243.          ((0,1,1,1,0),
  244.           (1,4,3,2,1),
  245.           (1,3,3,2,1),
  246.           (1,2,2,2,1),
  247.           (0,1,1,1,0));
  248.  
  249. VAR Logo : Array [1..5] of String;
  250.     loop1,loop2,loop3,loop4:integer;
  251. BEGIN
  252.   pal (13,0,63,0);
  253.   pal (1,0,0,40);
  254.   pal (2,0,0,45);
  255.   pal (3,0,0,50);
  256.   pal (4,0,0,60);
  257.   Logo[1]:=' O  OOO OOO O O O O O O OOO  O ';
  258.   Logo[2]:='O O O   O O O O O O O O  O  O O';
  259.   Logo[3]:='OOO OOO OOO OOO  O   O   O  OOO';
  260.   Logo[4]:='O O   O O   O O  O  O O  O  O O';
  261.   Logo[5]:='O O OOO O   O O  O  O O OOO O O';
  262.   For loop1:=1 to 5 do
  263.     For loop2:=1 to 31 do
  264.       if logo[loop1][loop2]='O' then
  265.         For loop3:=1 to 5 do
  266.           For loop4:=1 to 5 do
  267.             putpixel (loop2*10+loop3,loop1*4+loop4,ball[loop3,loop4],vaddr);
  268. END;
  269.  
  270.  
  271.  
  272. {──────────────────────────────────────────────────────────────────────────}
  273. Procedure RotatePoints (X,Y,Z:Integer);
  274.   { This rotates object lines by X,Y and Z; then places the result in
  275.     TRANSLATED }
  276. VAR loop1:integer;
  277.     temp:point;
  278. BEGIN
  279.   For loop1:=1 to maxlines do BEGIN
  280.     temp.x:=lines[loop1,1].x;
  281.     temp.y:=lookup[x,2]*lines[loop1,1].y - lookup[x,1]*lines[loop1,1].z;
  282.     temp.z:=lookup[x,1]*lines[loop1,1].y + lookup[x,2]*lines[loop1,1].z;
  283.  
  284.     translated[loop1,1]:=temp;
  285.  
  286.     If y>0 then BEGIN
  287.       temp.x:=lookup[y,2]*translated[loop1,1].x - lookup[y,1]*translated[loop1,1].y;
  288.       temp.y:=lookup[y,1]*translated[loop1,1].x + lookup[y,2]*translated[loop1,1].y;
  289.       temp.z:=translated[loop1,1].z;
  290.       translated[loop1,1]:=temp;
  291.     END;
  292.  
  293.     If z>0 then BEGIN
  294.       temp.x:=lookup[z,2]*translated[loop1,1].x + lookup[z,1]*translated[loop1,1].z;
  295.       temp.y:=translated[loop1,1].y;
  296.       temp.z:=-lookup[z,1]*translated[loop1,1].x + lookup[z,2]*translated[loop1,1].z;
  297.       translated[loop1,1]:=temp;
  298.     END;
  299.  
  300.     temp.x:=lines[loop1,2].x;
  301.     temp.y:=cos (rad(X))*lines[loop1,2].y - sin (rad(X))*lines[loop1,2].z;
  302.     temp.z:=sin (rad(X))*lines[loop1,2].y + cos (rad(X))*lines[loop1,2].z;
  303.  
  304.     translated[loop1,2]:=temp;
  305.  
  306.     If y>0 then BEGIN
  307.       temp.x:=cos (rad(Y))*translated[loop1,2].x - sin (rad(Y))*translated[loop1,2].y;
  308.       temp.y:=sin (rad(Y))*translated[loop1,2].x + cos (rad(Y))*translated[loop1,2].y;
  309.       temp.z:=translated[loop1,2].z;
  310.       translated[loop1,2]:=temp;
  311.     END;
  312.  
  313.     If z>0 then BEGIN
  314.       temp.x:=cos (rad(Z))*translated[loop1,2].x + sin (rad(Z))*translated[loop1,2].z;
  315.       temp.y:=translated[loop1,2].y;
  316.       temp.z:=-sin (rad(Z))*translated[loop1,2].x + cos (rad(Z))*translated[loop1,2].z;
  317.       translated[loop1,2]:=temp;
  318.     END;
  319.   END;
  320. END;
  321.  
  322.  
  323.  
  324. {──────────────────────────────────────────────────────────────────────────}
  325. Procedure DrawPoints;
  326.   { This draws the translated object to the virtual screen }
  327. VAR loop1:Integer;
  328.     nx,ny,nx2,ny2:integer;
  329.     temp:integer;
  330. BEGIN
  331.   For loop1:=1 to MaxLines do BEGIN
  332.     If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].z+zoff<0) then BEGIN
  333.       temp:=round (translated[loop1,1].z+zoff);
  334.       nx :=round (256*translated[loop1,1].X) div temp+xoff;
  335.       ny :=round (256*translated[loop1,1].Y) div temp+yoff;
  336.       temp:=round (translated[loop1,2].z+zoff);
  337.       nx2:=round (256*translated[loop1,2].X) div temp+xoff;
  338.       ny2:=round (256*translated[loop1,2].Y) div temp+yoff;
  339.       If (NX > 0) and (NX < 320) and (NY > 25) and (NY < 200) and
  340.          (NX2> 0) and (NX2< 320) and (NY2> 25) and (NY2< 200) then
  341.            line (nx,ny,nx2,ny2,13,vaddr);
  342.     END;
  343.   END;
  344. END;
  345.  
  346. {──────────────────────────────────────────────────────────────────────────}
  347. Procedure ClearPoints;
  348.   { This clears the translated object from the virtual screen ... believe it
  349.     or not, this is faster then a straight "cls (vaddr,0)" }
  350. VAR loop1:Integer;
  351.     nx,ny,nx2,ny2:Integer;
  352.     temp:integer;
  353. BEGIN
  354.   For loop1:=1 to MaxLines do BEGIN
  355.     If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].z+zoff<0) then BEGIN
  356.       temp:=round (translated[loop1,1].z+zoff);
  357.       nx :=round (256*translated[loop1,1].X) div temp+xoff;
  358.       ny :=round (256*translated[loop1,1].Y) div temp+yoff;
  359.       temp:=round (translated[loop1,2].z+zoff);
  360.       nx2:=round (256*translated[loop1,2].X) div temp+xoff;
  361.       ny2:=round (256*translated[loop1,2].Y) div temp+yoff;
  362.       If (NX > 0) and (NX < 320) and (NY > 25) and (NY < 200) and
  363.          (NX2> 0) and (NX2< 320) and (NY2> 25) and (NY2< 200) then
  364.            line (nx,ny,nx2,ny2,0,vaddr);
  365.     END;
  366.   END;
  367. END;
  368.  
  369.  
  370. {──────────────────────────────────────────────────────────────────────────}
  371. Procedure MoveAround;
  372.   { This is the main display procedure. Firstly it brings the object towards
  373.     the viewer by increasing the Zoff, then passes control to the user }
  374. VAR deg,loop1:integer;
  375.     ch:char;
  376. BEGIN
  377.   deg:=0;
  378.   ch:=#0;
  379.   Cls (vaddr,0);
  380.   DrawLogo;
  381.   For loop1:=-256 to -40 do BEGIN
  382.     zoff:=loop1*2;
  383.     RotatePoints (deg,deg,deg);
  384.     DrawPoints;
  385.     flip (vaddr,vga);
  386.     ClearPoints;
  387.     deg:=(deg+5) mod 360;
  388.   END;
  389.  
  390.   Repeat
  391.     if keypressed then BEGIN
  392.       ch:=upcase (Readkey);
  393.       Case ch of 'A' : zoff:=zoff+5;
  394.                  'Z' : zoff:=zoff-5;
  395.                  ',' : xoff:=xoff-5;
  396.                  '.' : xoff:=xoff+5;
  397.                  'S' : yoff:=yoff-5;
  398.                  'X' : yoff:=yoff+5;
  399.       END;
  400.     END;
  401.     DrawPoints;
  402.     flip (vaddr,vga);
  403.     ClearPoints;
  404.     RotatePoints (deg,deg,deg);
  405.     deg:=(deg+5) mod 360;
  406.   Until ch=#27;
  407. END;
  408.  
  409.  
  410. BEGIN
  411.   SetUpVirtual;
  412.   Writeln ('Greetings and salutations! Hope you had a great Christmas and New');
  413.   Writeln ('year! ;-) ... Anyway, this tutorial is on 3-D, so this is what is');
  414.   Writeln ('going to happen ... a wireframe square will come towards you.');
  415.   Writeln ('When it gets close, you get control. "A" and "Z" control the Z');
  416.   Writeln ('movement, "," and "." control the X movement, and "S" and "X"');
  417.   Writeln ('control the Y movement. I have not included rotation control, but');
  418.   Writeln ('it should be easy enough to put in yourself ... if you have any');
  419.   Writeln ('hassles, leave me mail.');
  420.   Writeln;
  421.   Writeln ('Read the main text file for ideas on improving this code ... and');
  422.   Writeln ('welcome to the world of 3-D!');
  423.   writeln;
  424.   writeln;
  425.   Write ('  Hit any key to contine ...');
  426.   Readkey;
  427.   SetMCGA;
  428.   SetUpPoints;
  429.   MoveAround;
  430.   SetText;
  431.   ShutDown;
  432.   Writeln ('All done. This concludes the eigth sample program in the ASPHYXIA');
  433.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  434.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  435.   Writeln ('Connectix BBS user, and occasionally read RSAProg.');
  436.   Writeln ('For discussion purposes, I am also the moderator of the Programming');
  437.   Writeln ('newsgroup on the For Your Eyes Only BBS.');
  438.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  439.   Writeln ('             Grant Smith');
  440.   Writeln ('             P.O. Box 270');
  441.   Writeln ('             Kloof');
  442.   Writeln ('             3640');
  443.   Writeln ('I hope to hear from you soon!');
  444.   Writeln; Writeln;
  445.   Write   ('Hit any key to exit ...');
  446.   Readkey;
  447. END.
  448.